10 ' DCREATE by Dan Dugan -- public domain
900 GOTO 1015
1000 PRINT CHR$(7):PRINT

	"To create a new file, you must first 'done' this file and then enter
1005 PRINT"DCREATE from the DIMS main menu.
1010 PRINT:DEFINT A-Z:GOTO 1670		'return to DEDIT
1015 PRINT CHR$(12);			'clear screen (TERM DEP)
1020 PRINT:PRINT"DCREATE March 20, 1982
1030 DEFINT A-Z
1040 ON ERROR GOTO 1950
1050 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,

	C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),

	SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
1060 PRINT: PRINT"Please define the record size for your new file.
1070 PRINT"You can choose size 1 or size 2.  Size 2 uses up twice as much disk
1080 PRINT"space as size 1.  Your usable storage per record equals the record
1090 PRINT"size minus the number of fields.
1100 PRINT
1110 PRINT"      1  128 characters per record (bytes)
1120 PRINT"      2  255 characters per record (bytes)
1130 PRINT: INPUT"    "; FT		'file type
1140	IF FT=0 THEN FT=1
1150	IF FT=1 THEN FT$=" ": GOTO 1190
1160	IF FT=2 THEN FT$="2": GOTO 1190
1170	IF FT<0 OR FT>2 THEN 1670
1180 GOTO 1060
1190 PRINT: PRINT"Here is a directory of the files currently on the disk...
1200 PRINT: WIDTH 70: FILES DD$(3)+"*.D?": WIDTH 255
1210 PRINT:PRINT:PRINT"Remember, if you create a file name which is the same as one ":

PRINT"that already exists, you will destroy the old file on the disc.":PRINT
1220 PRINT "Now create a new file...";
1230 GOSUB 1800 ' open up files
1240 '


				DEFINE FILE STRUCTURE


1250 N=0 'number of records in file
1260 C=1 ' change flag
1270 GOSUB 1770		'cs
1280 PRINT F$
1290 PRINT"Define file structure;  enter field name and type:
1300 PRINT"(to finish, enter 'stop')"
1310 FOR I=1 TO 15*FT
1320 PRINT
1330	PRINT"Name (4 char) of field ";:PRINT USING"##";I;
1340	INPUT T$
1350	IF T$="" THEN GOTO 1330
1360	IF T$="stop" THEN 1500
1370	INPUT"Field type (a or n)      ";T1$
1380	IF T1$="" THEN T1$="a"
1390	IF T1$<>"a" THEN GOTO 1410
1400	GOTO 1450
1410	IF T1$<>"n" THEN GOTO 1430
1420	GOTO 1450
1430	PRINT"Type must be 'a' or 'n'
1440	GOTO 1370
1450	T$=T$+"     "
1460	T$=LEFT$(T$,4) ' chop down to 4 char
1470	T$=T$+","+T1$
1480	N$(I)=T$:C(I)=1
1490 NEXT I
1500 NC=I-1
1510 N$(I)="stop0" ' end cue for many routines
1520 GOSUB 1770 'cs5
1530 PRINT"Structure definition complete."
1540 PRINT: PRINT"Name:  "F$; TAB(20); "Type: "FT
1550 PRINT:PRINT"Fields are:"
1560 PRINT
1570 FOR I=1 TO NC
1580	IF LEFT$(N$(I),4)="stop" THEN GOTO 1630
1590	PRINT USING"##"; I;
1600	PRINT ".  "; LEFT$(N$(I),4); " "; RIGHT$(N$(I),1)
1610 NEXT I
1620 '


				FINISH


1630 PRINT
1640 INPUT"Do you approve?  (y/n) ", A$
1650 IF A$="" THEN A$="y"
1660 IF A$<>"y" THEN CLOSE: GOTO 1060
1670 CHAIN DD$(1)+"DEDIT",1000
1680 '



				UCV


1690 Y$=""
1700 FOR J=1 TO LEN(X$)
1710	Y$=Y$+" "
1720	X=ASC(MID$(X$,J, 1))
1730	IF 96<X AND X<123 THEN MID$(Y$,J,1)=CHR$(X-32): GOTO 1750
1740	MID$(Y$,J,1)=MID$(X$,J,1)
1750 NEXT J
1760 RETURN
1770 '



				CLEAR SCREEN (TERM DEP)


1780 PRINT CHR$(12);
1790 RETURN
1800 '



				OPEN UP FILES SUB

				GET NAME


1810 F$=""
1820 C=0 ' clear change flag
1830 PRINT: PRINT TAB(13);: INPUT"Name of the file you want to open"; F$
1840 IF F$="" THEN 1830
1850 X$=F$
1860 GOSUB 1680 ' UCverter
1870 F$=Y$ ' make UC
1880 '


				OPEN UP FILES FOR REAL


1890 OPEN "R",1,DD$(3)+F$+".D"+FT$
1900 FIELD #1,128 AS R$
1910 OPEN "R",2,DD$(4)+F$+".DD"+FT$
1920 FIELD #2, 128 AS S$
1930 RETURN
1940 '
1950 '


				ERROR HANDLING ROUTINES


1960 IF ERR=53 AND ERL=1200 THEN RESUME 1210
1970 IF ERR=64 AND ERL=1890 THEN PRINT"*** Bad file name!":CLOSE:RESUME 1190
1980 IF ERR=61 AND (ERL=1890 OR ERL=1910) THEN CLOSE:RESUME 1190
1990 ON ERROR GOTO 0
